MacHack 1994/MacHack 1994.toast/MacHack™ 1987-1994/MacHack™ '87/DisAssembler ƒ/DISASSEMBLER.Bas

BASIC Source File | 1986-05-27 | 19.1 KB | 396 lines | [TEXT/MACA]

REM    This program is to be made available at no charge.
REM    Macintosh Explorer
REM    Author: O.  Andrade                        CServe: 74726,1177
REM                14 Shanley St.
REM                 Kitchener, Ontario
REM                 Canada
REM                 N2H  5N8
REM
REM   This program will run as is with MSBASIC 2.10 (b).  See line 920
REM   for note on running with MSBASIC version 2.0.  You must not alter the
REM   startup output window size for the program to run properly.  See
REM   BYTE magazine, March 1986, p. 145 for program description.-R.BASHAM


 DEFINT A-Z:GOSUB 550
 CLS:ON ERROR GOTO 4200:GOTO 2560
230 C2#=A0#:GOSUB 370:W=N
 FOR I6=0 TO 3
 C2#=C2#+2
 GOSUB 370:W0(I6)=N
 U0(I6)=F
 NEXT I6
 N6=F:N3=F
 N2=W0(0):N4=W0(1):GOSUB 420
 K=0:WHILE K<4 AND U0(K):K=K+1:WEND
  A0#=A0#+2+2*K
 RETURN
370 N=PEEK(C2#):IF N>127 THEN N=N OR &HFF00
 N=N*256+PEEK(C2#+1):RETURN

420 I4=0:WHILE((I4<O6)AND(W AND O2(I4))<>O3(I4)):I4=I4+1:WEND
 IF I4>=O6 GOTO 500
 S4=0:O4$="":O0$=O1$(I4):B=F
 IF O5(I4)>0 THEN ON O5(I4)GOSUB 1460,1470,1560,1480,1490,1520,1720,1730,1740,1750
 IF O5(I4)>10 THEN ON O5(I4)-10 GOSUB 2230,1770,1800,1570,1840,1870,1880,1900,1930,1970
 IF O5(I4)>20 THEN ON O5(I4)-20 GOSUB 1990,2300,2020,2030,2050,2080,1600,2120,2320,1680
 IF O5(I4)>30 THEN ON O5(I4)-30 GOSUB 1940,2360,2370,2380,2390,2400
  IF NOT B THEN PRINT A0#;"    ";O0$;"    ";O4$:GOTO 510
500 PRINT A0#;"    dw    $";HEX$(W):FOR I6=0 TO 3:U0(I6)=F:NEXT
510 RETURN

550 O6=71:DIM O2(O6),O3(O6),O1$(O6),O5(O6)
 FOR I=0 TO O6-1:READ O1$(I),O2(I),O3(I),O5(I):NEXT
 DATA        reset, -1, 20080,    1, nop, -1, 20081,    1, stop, -1, 20082, 1, rte, -1, 20083, 1
 DATA        rts, -1, 20085, 1, trapv, -1, 20086, 1, rtr, -1, 20087,    1, swap, -8, 18496, 2
 DATA        "ext.w", -8, 18560, 2, "ext.l", -8, 18624, 2, link, -8, 20048, 3, unlk, -8, 20056, 4
 DATA        move, -8, 20064, 35, move, -8, 20072, 36, trap, -16, 20032, 5
 DATA        nbcd, -64, 18432, 6, pea, -64, 18496, 6, move, -64, 16576, 32
 DATA        move, -64, 17600, 34, move, -64, 18112, 33, tas, -64, 19136, 6
 DATA        jsr, -64, 20096, 6, jmp, -64, 20160, 6, exg, -3592, -16064, 7
 DATA        exg, -3592, -16056, 8, exg, -3592, -15992, 9, sbcd, -3600, -32512, 10
 DATA        abcd, -3600, -16128, 10, movem, -128, 18560, 11, movem, -128, 19584, 11
 DATA        db, -3848, 20680, 12, statBit, -256, 2048, 13, tst, -256, 18944,14
 DATA        clr, -256, 16896, 14, neg, -256, 17408, 14, or, -256, 0, 30
 DATA        not, -256, 17920, 14, and, -256, 512, 30, bsr, -256, 24832, 15
 DATA        sub, -256, 1024, 30, cmpm, -3784, -20216, 16, add, -256, 1536, 30
 DATA        eor, -256, 2560, 30, cmp, -256, 3072, 30, negx, -256, 16384, 14
 DATA        subx, -3792, -28416,17, movep, -4040, 8, 18, mulu, -3684, -16192,19
 DATA        muls, -3648, -15936, 19, chk, -3648, 16768, 19, divu, -3648, -32576, 19
 DATA        divs, -3648, -32320, 19, lea, -3648, 16832, 31, addx, -3792, -12032, 17
 DATA        memShifts, -1856, -8000, 20, s, -3904, 20672, 21, dynBit, -3840, 256, 22
 DATA        eor, -3840, -20224, 23, addq, -3840, 20480, 24, subq, -3840, 20736, 24
 DATA        moveq, -3840, 28672, 25, b, -4096, 24576, 26, "move.b", -4096, 4096, 27
 DATA        sub, -4096, -28672, 28, "move.l", -4096, 8192, 27, cmp, -4096, -20480, 28
 DATA        or, -4096, -32768, 28, add, -4096, -12288, 28, "move.w", -4096, 12288, 27
 DATA        dataRegShifts, -4096, -8192, 29, and, -4096, -16384, 28
  A5=ASC("0"):A6=ASC("a"):F=0:T=NOT F
 DIM S3$(3):S3$(0)=".b":S3$(1)=".w":S3$(2)=".l"
 DIM W0(3),U0(3),C0$(16),B3$(4),S2$(4),M(16)
 C0$(0)="t":C0$(1)="f":C0$(2)="hi":C0$(3)="ls"
 C0$(4)="cc":C0$(5)="cs":C0$(6)="ne":C0$(7)="eq"
 C0$(8)="vc":C0$(9)="vs":C0$(10)="pl":C0$(11)="mi"
 C0$(12)="ge":C0$(13)="lt":C0$(14)="gt":C0$(15)="le"
 B3$(0)="btst":B3$(1)="bchg":B3$(2)="bclr":B3$(3)="bset"
 S2$(0)="as":S2$(1)="ls":S2$(2)="rox":S2$(3)="ro"
 CALL TEXTFONT(4):CALL TEXTSIZE(9)
920 B5=85:B4=15:S=297: REM SET S=278 FOR MSBASIC V 2.0
 DIM I8(4):I.=5:I00=5:I8(0)=I00:I8(1)=I.:I8(2)=I8(0)+B4:I8(3)=I8(1)+B5
 DIM M0(4):M2=I.+B5+20:M3=I00:M0(0)=M3:M0(1)=M2:M0(2)=M0(0)+B4:M0(3)=M0(1)+B5
 DIM D7(4):D.=M2+B5+20:D00=I00:D7(0)=D00:D7(1)=D.:D7(2)=D7(0)+B4:D7(3)=D7(1)+B5
 DIM D(4):D1=I.:D2=I00+B4+5:D(0)=D2:D(1)=D1:D(2)=D(0)+B4:D(3)=D(1)+B5
 DIM D02(4):D04=M2:D05=D2:D02(0)=D05:D02(1)=D04:D02(2)=D02(0)+B4:D02(3)=D02(1)+B5
 DIM L0(4):L2=D.:L3=D2:L0(0)=L3:L0(1)=L2:L0(2)=L0(0)+B4:L0(3)=L0(1)+B5
 DIM A1(4):A3=D.+B5+20:A4=D2:A1(0)=A4:A1(1)=A3:A1(2)=A1(0)+B4:A1(3)=A1(1)+B5
 DIM V(4):V2=A3+B5+10:V3=D2:V(0)=V3:V(1)=V2:V(2)=V(0)+B4:V(3)=V(1)+B5
 DIM C1(4):C1(0)=0:C1(1)=0:C1(2)=V(2)+4:C1(3)=V(3)
 DIM I01(1),I7(1):N1=1
 DIM D9(310):D5=0:D3=0:B2=52:FOR I5=0 TO 27:READ D9(I5):NEXT
 DATA  &h4e56, 0, 16890, 50, 12668, -5, 24
 DATA  12668, 1, 22, 12668, 1, 44, 8572, 0, 0, 46, 8572, 0
 DATA  512, 36, 17402, 60, 8521, 32, &ha002, &h4e5e, &h4e75
 U=0:I9=1:M1=2:D8=3:D0=4
 D03=5:A2=6:V0=7:L1=8
 S1=M1:RETURN
1100 E$=""
 ON M4+1 GOSUB 1130,1140,1150,1160,1170,1180,1190,1250
 RETURN
1130 E$="d"+CHR$(R0+A5):RETURN
1140 E$="a"+CHR$(R0+A5):RETURN
1150 E$="(a"+CHR$(R0+A5)+")":RETURN
1160 E$="(a"+CHR$(R0+A5)+")+":RETURN
1170 E$="-(a"+CHR$(R0+A5)+")":RETURN
1180 E$=STR$(N2)+" (a"+CHR$(R0+A5)+")":N6=T:RETURN
1190 IF N2<0 THEN E$="a"ELSE E$="d"
 E$=E$+CHR$((N2 AND &H7000)\4096+A5)
 IF N2 AND &H800 THEN E$=E$+".l"
 E$=" (a"+CHR$(R0+A5)+", "+E$+")"
 IF(N2 AND &H80)THEN E$=STR$((N2 AND &HFF)OR &HFF00)+E$ELSE E$=STR$(N2 AND &HFF)+E$
 N6=T:RETURN
1250 ON R0+1 GOSUB 1280,1290,1310,1320,1380,1270,1270,1270
 RETURN
1270 B=T:RETURN
1280 E$="($"+HEX$(N2)+")":N6=T:RETURN
1290 GOSUB 1410:E$="($"+HEX$(N2)+I3$+")"
 N6=T:N3=T:RETURN
1310 E$=STR$(N2)+"(pc)":N6=T:RETURN
1320 IF N2<0 THEN E$="a"ELSE E$="d"
 E$=E$+CHR$((N2 AND &H7000)\4096+A5)
 IF N2 AND &H800 THEN E$=E$+".l"
 E$="(pc, "+E$+")"
 IF(N2 AND &H80)THEN E$=STR$((N2 AND &HFF)OR &HFF00)+E$ELSE E$=STR$(N2 AND &HFF)+E$
 N6=T:RETURN
1380 E$="#$"+HEX$(N2):N6=T
 IF S4=2 THEN GOSUB 1410:E$=E$+I3$:N3=T
 RETURN
1410 I3$=HEX$(N4):IF LEN(I3$)<4 THEN I3$=STRING$(4-LEN(I3$),"0")+I3$
1420 RETURN
1460 O4$="":RETURN
1470 O4$="d"+CHR$((W AND 7)+A5):RETURN
1480 O4$="a"+CHR$((W AND 7)+A5):RETURN
1490 IF((W AND 15)>9)THEN 1510
 O4$=CHR$((W AND 15)+A5):RETURN
1510 O4$=CHR$((W AND 15)+A6-10):RETURN
1520 M4=(W AND &H38)\8:R0=(W AND 7)
GOSUB 1100:O4$=E$:IF N6 THEN U0(0)=T
 IF N3 THEN U0(1)=T
 RETURN
1560 O4$="a"+CHR$((W AND 7)+A5)+", "+STR$(N2):U0(0)=T:RETURN
1570 S4=(W AND &HC0)\64:M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100:O4$=E$:O0$=O0$+S3$(S4)
1580 IF N6 THEN U0(0)=T:IF N3 THEN U0(1)=T
1590 RETURN
1600 M4=(W AND &H38)\8:R0=(W AND 7)
1610 IF(W AND &HF000)=&H1000 THEN S4=0ELSE IF(W AND &HF000)=&H2000 THEN S4=2ELSE S4=1
1620 GOSUB 1100:S0$=E$
1630 IF N6 THEN U0(0)=T:N6=F:IF N3 THEN U0(1)=T:N3=F:N2=W0(2):N4=W0(3)ELSE N2=N4:N4=W0(2)
1640 M4=(W AND &H1C0)\64:R0=(W AND &HE00)\512:GOSUB 1100:O4$=S0$+", "+E$
1650 IF N6 THEN IF U0(0)THEN IF U0(1)THEN U0(2)=TELSE U0(1)=TELSE U0(0)=T
1660 IF N3 THEN IF U0(1)THEN IF U0(2)THEN U0(3)=TELSE U0(2)=TELSE U0(1)=T
1670 RETURN
1680 S4=(W AND &HC0)\64:M4=(W AND &H38)\8:R0=(W AND 7):O4$="#$"+HEX$(N2):U0(0)=T:IF S4<>2 THEN O4$=O4$+", "ELSE GOSUB 1410:N3=T:O4$=O4$+I3$+", "
1690 IF((W AND &H3F)=&H3C)THEN O4$=O4$+"sr":GOTO 1700ELSE IF NOT N3 THEN N2=W0(1):N4=W0(2)ELSE U0(1)=T:N3=F:N2=W0(2):N4=W0(3)
1695 GOSUB 1100:O4$=O4$+E$
1700 O0$=O0$+S3$(S4):IF N6 THEN IF NOT U0(1)THEN U0(1)=T:IF NOT N3 THEN RETURN ELSE U0(2)=TELSE U0(2)=T:IF N3 THEN U0(3)=T
1710 RETURN
1720 O4$="d"+CHR$((W AND &HE00)\512+A5)+", d"+CHR$((W AND 7)+A5):RETURN
1730 O4$="a"+CHR$((W AND &HE00)\512+A5)+", a"+CHR$((W AND 7)+A5):RETURN
1740 O4$="d"+CHR$((W AND &HE00)\512+A5)+", a"+CHR$((W AND 7)+A5):RETURN
1750 IF(W AND 8)THEN 1760ELSE O4$="d"+CHR$((W AND 7)+A5)+", d"+CHR$((W AND &HE00)\512+A5):RETURN
1760 O4$="-(a"+CHR$((W AND 7)+A5)+"), -(a"+CHR$((W AND &HE00)\512+A5)+")":RETURN
1770 O0$=O0$+C0$((W AND &HF00)\256):O4$="d"+CHR$((W AND 7)+A5)+", $"
1780 U0(0)=T:IF N2<0 THEN O4$=O4$+STR$(N2)ELSE O4$=O4$+" +"+STR$(N2)
1790 RETURN
1800 O0$=B3$((W AND &H60)\64):M4=((W AND &H38)\8):R0=(W AND 7)
1810 U0(0)=T:O4$="#"+STR$((&H1F AND N2))+", ":N2=N4:N4=W0(2):GOSUB 1100:O4$=O4$+E$
1820 IF N6 THEN U0(1)=T:IF N3 THEN U0(2)=T
1830 RETURN
1840 IF(W AND 128)THEN O0$=O0$+".s": O4$="$ "+STR$((W AND &HFF)OR &HFF00)+";    "+STR$(A0#+2-(W AND &HFF)):RETURN
1850 IF(W AND &HFF)=0 THEN U0(0)=T:IF N2<0 THEN O4$="$ "+STR$(N2)+";    "+STR$(A0#+4+N2):RETURN ELSE O4$="$ +"+STR$(N2)+";    "+STR$(A0#+4+N2):RETURN
1860 O0$=O0$+".s": O4$="$ +"+STR$(W AND &HFF)+";    "+STR$(A0#+2+(W AND &HFF)):RETURN
1870 O0$=O0$+S3$((W AND &HC0)\128):O4$="(a"+CHR$((W AND 7)+A5)+")+, (a"+CHR$((W AND &HE00)\512+A5)+")+":RETURN
1880 IF(W AND 8)THEN 1890ELSE O4$="d"+CHR$((W AND 7)+A5)+", d"+CHR$((W AND &HE00)\512+A5):RETURN
1890 O4$="-(a"+CHR$((W AND 7)+A5)+"), -(a"+CHR$((W AND &HE00)\512+A5)+")":RETURN
1900 U0(0)=T:IF(W AND 64)THEN O0$=O0$+".l"ELSE O0$=O0$+".w"
1910 IF(W AND 128)THEN O4$="d"+CHR$((W AND &HE00)\512+A5)+","+STR$(N2)+"(a"+CHR$((W AND 7)+A5)+")":RETURN
1920 O4$=STR$(N2)+"(a"+CHR$((W AND 7)+A5)+"), d"+CHR$((W AND &HE00)\512+A5):RETURN
1930 M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100:O4$=E$+", d"+CHR$((W AND &HE00)\512+A5):GOTO 1950
1940 M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100:O4$=E$+", a"+CHR$((W AND &HE00)\512+A5)
1950  IF N6 THEN U0(0)=T:IF N3 THEN U0(1)=T
1960 RETURN
1970 O0$=S2$((W AND &H600)\512):IF(W AND 256)THEN O0$=O0$+"l"ELSE O0$=O0$+"r"
1980 M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100:O4$=E$:GOSUB 1580:RETURN
1990 O0$=O0$+C0$((W AND &HF00)\256):M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100:O4$=E$:GOSUB 1580:RETURN
2000 O0$=B3$((W AND &H60)\64):O4$="d"+CHR$((W AND &HE00)\512+A5)+", "
2010 M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100:O4$=O4$+E$:GOSUB 1580:RETURN
2020 O4$="d"+CHR$((W AND &HE00)\512+A5):GOTO 2040
2030 t0=(W AND &HE00)\512: IF t0=0 THEN O4$="#8" ELSE O4$="#"+CHR$(t0+A5)
2040 S4=(W AND &HC0)\64 :O0$=O0$+S3$(S4):M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100:O4$=O4$+", "+E$:GOSUB 1580:RETURN
2050 O4$=", d"+CHR$((W AND &HE00)\512+A5)
2060 IF(W AND 128)THEN O4$="#"+STR$((W AND &HFF)OR &HFF00)+O4$:RETURN
2070 O4$="#"+STR$(W AND &HFF)+O4$:RETURN
2080 O0$=O0$+C0$((W AND &HF00)\256):IF(W AND 128)THEN O0$=O0$+".s": O4$="$"+STR$((W AND &HFF)OR &HFF00)+";    "+STR$(A0#+2-(W AND &HFF)):RETURN
2090 IF(W AND &HFF)=0 THEN U0(0)=T:O0$=O0$+".w": IF N2<0 THEN O4$="$ "+STR$(N2)+";    "+STR$(A0#+4+N2):RETURN ELSE O4$="$ +"+STR$(N2)+";    "+STR$(A0#+4+N2):RETURN
2100 O0$=O0$+".s": O4$="$ +"+STR$((W AND &HFF))+";    "+STR$(A0#+2+(W AND &HFF)):RETURN
2110 RETURN
2120 O=(W AND &HE0)\64+1:ON O GOSUB 2160,2170,2180,2160,2170,2180,2170,2180
2130 ON O GOSUB 2190,2190,2190,2200,2200,2200,2210,2210
2140 IF N6 THEN U0(0)=T:IF N3 THEN U0(1)=T
2150 RETURN
2160 O0$=O0$+".b":S4=0:RETURN
2170 O0$=O0$+".w":S4=1:RETURN
2180 O0$=O0$+".l":S4=2:RETURN
2190  GOSUB 2220:O4$=E$+", d"+CHR$((W AND &HE00)\512+A5):RETURN
2200  GOSUB 2220:O4$="d"+CHR$((W AND &HE00)\512+A5)+", "+E$:RETURN
2210  GOSUB 2220:O4$=E$+", a"+CHR$((W AND &HE00)\512+A5):RETURN
2220 M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100:RETURN
2230 IF(W AND 64)THEN O0$=O0$+".l":S4=2ELSE O0$=O0$+".w":S4=1
2240 R2=N2:U0(0)=T:N2=N4:N4=W0(2)
2250 M4=(W AND &H38)\8:R0=(W AND 7):GOSUB 1100
2260 IF N6 THEN U0(1)=T:IF N3 THEN U0(2)=T
2270 IF M4=4 THEN FOR I1=1 TO 15:M(I1)=2^(15-I1):NEXT:M(0)=-32768!ELSE FOR I1=0 TO 14:M(I1)=2^I1:NEXT:M(15)=-32768!
2280 GOSUB 2440:IF(W AND &HF00)=&H800 THEN O4$=O4$+", "+E$ELSE O4$=E$+", "+O4$
2290 RETURN
2300 O4$="d"+CHR$((W AND &HE00)\512+A5)
2310 O0$=B3$((W AND &HC0)\64):M4=((W AND &H38)\8):R0=(W AND 7):GOSUB 1100:O4$=O4$+", "+E$:GOSUB 1580:RETURN
2320 IF(W AND 32)THEN O4$="d"+CHR$((W AND &HE00)\512+A5)ELSE t0=(W AND &HE00)\512: IF t0=0 THEN O4$=#8" else O4$="#"+chr$(t0+A5)
2330 O4$=O4$+", d"+CHR$((W AND 7)+A5)
2340 O0$=S2$((W AND &H18)\8):IF(W AND 256)THEN O0$=O0$+"l"ELSE O0$=O0$+"r"
2350 O0$=O0$+S4$((W AND &HC0)\64):RETURN
2360 GOSUB 1520:O4$="sr, "+O4$:RETURN
2370 GOSUB 1520:O4$=O4$+", sr":RETURN
2380 GOSUB 1520:O4$=O4$+", ccr":RETURN
2390 GOSUB 1480:O4$=O4$+", usp":RETURN
2400 GOSUB 1480:O4$="usp, "+O4$:RETURN
2410
2420 REM return movem operand (extension word decoding)
2430
2440 FOR I1=0 TO 1
2450 F0=T:IF I1=0 THEN O4$="":R$="d"ELSE R$="a":IF O4$<>""THEN IF M(15)<0 AND(R2 AND &HFF00)<>0 THEN O4$=O4$+"/"ELSE IF M(15)>0 AND(R2 AND &HFF)<>0 THEN O4$=O4$+"/"
2460 I2=0:WHILE I2<8
2470 IF(M(I2+I1*8)AND R2)=0 THEN J0=I2+1:GOTO 2510
2480 IF F0 THEN O4$=O4$+R$+CHR$(I2+A5):F0=F ELSE O4$=O4$+", "+R$+CHR$(I2+A5)
2490 J0=I2+1:WHILE J0<8 AND(M(J0+I1*8)AND R2):J0=J0+1:WEND
2500 IF(M(J0+I1*8-1)AND R2)AND J0>I2+1 THEN O4$=O4$+"-"+R$+CHR$(J0+A5-1)
2510 I2=J0:WEND
2520 NEXT:RETURN
2530
2540 REM main loop
2550
2560 L=F:GOSUB 2950
2570 WHILE NOT L
2580 GOSUB 2650
2590 ON R1 GOSUB 2820,2820,2820,3130,3230,3420,3450,2615
2600 WEND
2610 END
2615 IF MOUSE(0)<>0 THEN L=T:SYSTEM ELSE RETURN
2620
2630 REM determine mouse region
2640
2650 D06=MOUSE(1)-I.:D07=MOUSE(2)-I00:IF 0<=D06 AND D06<B5 AND 0<=D07 AND D07<=B4 THEN R1=I9:D01=MOUSE(0):RETURN
2660 D06=MOUSE(1)-M2:D07=MOUSE(2)-M3:IF 0<=D06 AND D06<B5 AND 0<=D07 AND D07<=B4 THEN R1=M1:D01=MOUSE(0):RETURN
2670 D06=MOUSE(1)-D.:D07=MOUSE(2)-D00:IF 0<=D06 AND D06<B5 AND 0<=D07 AND D07<=B4 THEN R1=D8:D01=MOUSE(0):RETURN
2680 D06=MOUSE(1)-D1:D07=MOUSE(2)-D2:IF 0<=D06 AND D06<B5 AND 0<=D07 AND D07<=B4 THEN R1=D0:D01=MOUSE(0):RETURN
2690 D06=MOUSE(1)-D04:D07=MOUSE(2)-D05:IF 0<=D06 AND D06<B5 AND 0<=D07 AND D07<=B4 THEN R1=D03:D01=MOUSE(0):RETURN
2695 D06=MOUSE(1)-L2:D07=MOUSE(2)-L3:IF 0<=D06 AND D06<B5 AND 0<=D07 AND D07<=B4 THEN R1=L1:D01=MOUSE(0):RETURN
2700 D06=MOUSE(1)-A3:D07=MOUSE(2)-A4:IF 0<=D06 AND D06<B5 AND 0<=D07 AND D07<=B4 THEN R1=A2:D01=MOUSE(0):RETURN
2710 D06=MOUSE(1)-V2:D07=MOUSE(2)-V3:IF 0<=D06 AND D06<B5 AND 0<=D07 AND D07<=B4 THEN R1=V0:D01=MOUSE(0):RETURN
2720 R1=U:D01=MOUSE(0):RETURN
2730
2740 REM select a path
2750
2760 ON S1 GOSUB 2780,2790,2800
2770 RETURN
2780 CALL INVERTRECT(VARPTR(I8(0))):RETURN
2790 CALL INVERTRECT(VARPTR(M0(0))):RETURN
2800 CALL INVERTRECT(VARPTR(D7(0))):RETURN
2810
2820 IF MOUSE(0)=0 THEN RETURN ELSE ON S1 GOSUB 2880,2890,2900
2830 ON R1 GOSUB 2850,2860,2870
2840 S1=R1:WHILE MOUSE(0)=1:WEND:GOSUB 2940:RETURN
2850 A0#=C:RETURN
2860 A0#=M5#:RETURN
2870 A0#=D4#:RETURN
2880 C=A0#:RETURN
2890 M5#=A0#:RETURN
2900 D4#=A0#:RETURN
2910
2920 REM draw screen controls
2930
2940 CALL ERASERECT(VARPTR(C1(0)))
2950 CALL MOVETO(I8(1)+10,I8(2)-5):PRINT"input";:CALL FRAMERECT(VARPTR(I8(0)))
2960 CALL MOVETO(M0(1)+10,M0(2)-5):PRINT"memory";:CALL FRAMERECT(VARPTR(M0(0)))
2970 CALL MOVETO(D7(1)+10,D7(2)-5):PRINT"disk";:CALL FRAMERECT(VARPTR(D7(0)))
2980 CALL MOVETO(D(1)+10,D(2)-5):PRINT"disassemble";:CALL FRAMERECT(VARPTR(D(0)))
2990 CALL MOVETO(D02(1)+10,D02(2)-5):PRINT"dump";:CALL FRAMERECT(VARPTR(D02(0)))
2995 CALL MOVETO(L0(1)+10,L0(2)-5):PRINT"quit";:CALL FRAMERECT(VARPTR(L0(0)))
3000 CALL MOVETO(A1(1)+5,D7(2)-5):PRINT"address";
3010 CALL MOVETO(V(1)+5,D7(2)-5):PRINT"value";
3020 CALL MOVETO(A1(1)+5,A1(2)-5):PRINT A0#;:CALL FRAMERECT(VARPTR(A1(0)))
3030 CALL MOVETO(V(1)+5,V(2)-5):ON S1 GOSUB 3050,3070,3080:PRINT V1$;:CALL FRAMERECT(VARPTR(V(0)))
3040 GOSUB 2760:RETURN
3050 IF A0#>=N1 THEN V1$="?"ELSE IF P THEN V1$=STR$(I01(A0#))ELSE V1$=STR$(I7(A0#))
3060 RETURN
3070 C2#=A0#:GOSUB 370:V1$=STR$(N):RETURN
3080 IF 0>A0#-D5*256 OR A0#-D5*256>=2*D3 THEN V1$="?"ELSE V1$=STR$(D9((A0#-D5*256)\2+B2))
3090 RETURN
3100
3110 REM mouse in disassemble button
3120
3130 IF MOUSE(0)=0 THEN RETURN
3140 WHILE MOUSE(0)<>0
3150  CALL MOVETO(0,S)
3160  ON S1 GOSUB 3730,230,3990: 'pick a path
3170 GOSUB 2940:D01=MOUSE(0)
3180 WEND
3190 RETURN
3200
3210 REM mouse in dump button
3220
3230 IF MOUSE(0)=0 THEN RETURN
3240 WHILE MOUSE(0)<>0
3250  CALL MOVETO(0,S)
3260  ON S1 GOSUB 3820,3330,4100
3270 GOSUB 2940:D01=MOUSE(0)
3280 WEND
3290 RETURN
3300
3310 REM dump input path
3320
3330 I2$="":PRINT A0#;"    ";
3340 FOR I0=0 TO 15
3350 I1=PEEK(A0#):IF I1<16 THEN PRINT"0";HEX$(I1);ELSE PRINT HEX$(I1);
3360 IF ASC(" ")<I1 AND I1<128 THEN I2$=I2$+CHR$(I1)ELSE I2$=I2$+"."
3370 A0#=A0#+1:NEXT
3380 PRINT"    ";I2$:RETURN
3390
3400 REM mouse in address box
3410
3420 IF MOUSE(0)=0 THEN RETURN
3430  CALL INVERTRECT(VARPTR(A1(0))):CALL MOVETO(A1(1)+5,A1(2)-5):B1=T:GOSUB 3520
3440 CALL INVERTRECT(VARPTR(A1(0))):D01=MOUSE(0):A0#=N5#:GOSUB 2940:RETURN
3450 IF MOUSE(0)=0 THEN RETURN
3460  CALL INVERTRECT(VARPTR(V(0))):CALL MOVETO(V(1)+5,V(2)-5):ON S1 GOSUB 3650,3645,3645
3470 D01=MOUSE(0):IF N5#>32767 THEN N5#=N5#-65536!
3480 V1=N5#:RETURN
REM fetch keys: address or input
3520 I1$=INKEY$:IF I1$=""THEN 3520
3530 IF ASC(I1$)=13 THEN IF N0 THEN N5#=-1*N5#:RETURN ELSE RETURN
3540 IF B1 THEN N5#=0:B1=F:H=F:N0=F:IF I1$="$"THEN H=T:PRINT I1$;:GOTO 3520ELSE IF I1$="-"THEN PRINT I1$;:N0=T:GOTO 3520
3550 IF"0"<=I1$AND I1$<="9"THEN PRINT I1$;:A7=ASC(I1$)-ASC("0"):IF H THEN N5#=N5#*16+A7:GOTO 3520ELSE N5#=N5#*10+A7:GOTO 3520
3560 IF"A"<=I1$AND I1$<="F"THEN IF NOT H THEN BEEP:GOTO 3520ELSE PRINT I1$;:N5#=N5#*16+ASC(I1$)-ASC("A")+10:GOTO 3520
3570 IF"a"<=I1$AND I1$<="f"AND H THEN PRINT I1$;:N5#=N5#*16+ASC(I1$)-ASC("a")+10:GOTO 3520
3580 BEEP:GOTO 3520

3620 P=NOT P:IF P THEN ERASE I01:DIM I01(A0#+1)ELSE ERASE I7:DIM I7(A0#+1)
3630 FOR I1=0 TO N1-1:IF P THEN I01(I1)=I7(I1)ELSE I7(I1)=I01(I1)
3640 NEXT:N1=A0#+1
3645 RETURN
REM    disassemble input
3650 IF A0#>=N1 THEN GOSUB 3620
3660 B1=T:GOSUB 3520:N5#=N5#-65536!*INT(N5#/65536!):IF N5#>32767 THEN N5#=N5#-65536!
3670 IF P THEN I01(A0#)=N5#ELSE I7(A0#)=N5#
3680 A0#=A0#+1:GOSUB 2940:RETURN
3730 IF A0#>N1 THEN W=-1ELSE IF P THEN W=I01(A0#)ELSE W=I7(A0#)
3740 P0=A0#:FOR I6=0 TO 3:P0=P0+1:IF P0>=N1 THEN W0(I6)=-1ELSE IF P THEN W0(I6)=I01(P0)ELSE W0(I6)=I7(P0)
3750 U0(I6)=F:NEXT:N6=F:N3=F
3760 N2=W0(0):N4=W0(1):GOSUB 420
3770 K=0:WHILE K<4 AND A0#+1+K<N1 AND U0(K):K=K+1:WEND
3780 A0#=A0#+1+K:RETURN
REM    dump disk
3820 PRINT A0#;"    ";:I2$="":FOR I0=0 TO 7
3830 IF A0#>=N1 THEN PRINT"????";:I2$=I2$+"  ":GOTO 3880
3840 IF P THEN I1=I01(A0#)ELSE I1=I7(A0#)
3850 I3$=HEX$(I1):IF LEN(I3$)=4 THEN PRINT I3$;ELSE PRINT STRING$(4-LEN(I3$),"0");I3$;
3860 IF(ASC(" ")<INT(I1\256))AND(INT(I1\256)<128)THEN I2$=I2$+CHR$(INT(I1\256))ELSE I2$=I2$+"."
3870 IF ASC(" ")<(I1 AND 255)AND(I1 AND 255)<128 THEN I2$=I2$+CHR$(I1 AND 255)ELSE I2$=I2$+"."
3880 A0#=A0#+1:NEXT:PRINT"    ";I2$
3890 RETURN
REM    fetch a disk sector
3930 B0=F:D5=INT(A0#/512):IF D5 AND 64 THEN D9(15)=(D5 OR &HFF80)*512ELSE D9(15)=(D5 AND &H7F)*512
3935 D9(14)=D5\128:D5=2*D5:D6!=VARPTR(D9(0)):CALL D6!
3940 D3=(D9(28+20)*256+D9(28+21))\2:IF A0#-D5*256>=2*D3 THEN B0=T
3950 RETURN
REM disassemble disk
3990 IF A0#-D5*256<0 OR A0#-D5*256>2*D3 THEN GOSUB 3930:IF B0 THEN BEEP:RETURN
4000 P0=(A0#-256*D5)\2:A0#=2*P0+256*D5:W=D9(P0+B2)
4010 FOR I6=0 TO 3:P0=P0+1:IF P0>=D3 THEN J#=A0#:A0#=A0#+2*P0:GOSUB 3930:P0=0:A0#=J#:IF B0 THEN W0(I6)=-1:GOTO 4030
4020 W0(I6)=D9(P0+B2)
4030 U0(I6)=F:NEXT:N6=F:N3=F
4040 N2=W0(0):N4=W0(1):GOSUB 420
4050 K=0:WHILE K<4 AND U0(K):K=K+1:WEND
4060 A0#=A0#+2+2*K:RETURN
REM    dump disk
4100 IF 2*INT(A0#/2)<>A0#THEN A0#=A0#-1
4105 PRINT A0#;"    ";:I2$="":FOR I0=0 TO 7
4110 IF A0#-D5*256<0 OR A0#-D5*256>=2*D3 THEN GOSUB 3930:IF B0 THEN PRINT"????";:I2$=I2$+"  ":GOTO 4160
4120 I1=D9((A0#-D5*256)\2+B2)
4130 I3$=HEX$(I1):IF LEN(I3$)=4 THEN PRINT I3$;ELSE PRINT STRING$(4-LEN(I3$),"0");I3$;
4140 IF(ASC(" ")<INT(I1\256))AND(INT(I1\256)<128)THEN I2$=I2$+CHR$(INT(I1\256))ELSE I2$=I2$+"."
4150 IF ASC(" ")<(I1 AND 255)AND(I1 AND 255)<128 THEN I2$=I2$+CHR$(I1 AND 255)ELSE I2$=I2$+"."
4160 A0#=A0#+2:NEXT:PRINT"    ";I2$
4170 RETURN
REM    expand the input path array
4200 IF NOT(ERL=3620 AND ERR=7)THEN ON ERROR GOTO 0
4210 BEEP:BEEP:P=NOT P:IF P THEN DIM I7(1)ELSE DIM I01(1)
4220 GOSUB 2940:RESUME 2570